home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbtask.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  31.2 KB  |  956 lines

  1. (*===========================================================================*)
  2. (* Task switcher                                                             *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. UNIT BBTASK;
  10.  
  11. INTERFACE
  12.  
  13. USES
  14.   bbdummy;
  15.  
  16. FUNCTION  task_create(ic : POINTER; stack_size : WORD) : tcb_ptr;
  17. PROCEDURE tcb_init(this_tcb : tcb_ptr);
  18. PROCEDURE task_switch;
  19. PROCEDURE task_destroy(kill_tcb : tcb_ptr);
  20. PROCEDURE task_destroy_active;
  21. PROCEDURE task_free(this_tcb : tcb_ptr);
  22. FUNCTION  task_is_dead(this_tcb : tcb_ptr) : BOOLEAN;
  23.  
  24. TYPE
  25.   task_array_element = RECORD
  26.                          element_stack_size : WORD;
  27.                          element_tcb_ptr       : tcb_ptr;
  28.                        END;
  29.  
  30.   task_array = ARRAY[1..500] OF task_array_element;
  31.  
  32. VAR
  33.   system_startup   : BOOLEAN;
  34.   task_array_ptr   : ^task_array;
  35.  
  36. IMPLEMENTATION
  37.  
  38. USES
  39.   CRT,
  40.   DOS,
  41.   bbbug,
  42.   bbconvm,
  43.   bbdump,
  44.   bbmem,
  45.   bbsema2,
  46.   bbstack,
  47.   bbover,
  48.   bbwin;
  49.  
  50. (*===========================================================================*)
  51. (* Debugging control                                                         *)
  52. (*===========================================================================*)
  53.  
  54. {$UNDEF taskdebug}
  55. {$UNDEF stckdebug}
  56. {$UNDEF taskalbug}
  57. {$UNDEF fwdkdebug}
  58.  
  59. (*===========================================================================*)
  60. (* Common types and variables                                                *)
  61. (*===========================================================================*)
  62.  
  63. VAR
  64.   set_bp           : WORD;
  65.   set_sp           : WORD;
  66.   set_ss           : WORD;
  67.   task_start_place : POINTER;
  68.  
  69. (*===========================================================================*)
  70. (* Forward calls to routines in here                                         *)
  71. (*===========================================================================*)
  72.  
  73. PROCEDURE task_start;                    FORWARD;
  74. PROCEDURE tcb_drop(this_tcb : tcb_ptr);  FORWARD;
  75.  
  76. (*===========================================================================*)
  77. (* Create a new task                                                         *)
  78. (*===========================================================================*)
  79.  
  80. FUNCTION  task_create(ic : POINTER; stack_size : WORD) : tcb_ptr;
  81.  
  82.   VAR
  83.     i           : BYTE;
  84.     j           : INTEGER;
  85.     this_one    : BYTE;
  86.     maybe_this  : BYTE;
  87.     new_tcb     : tcb_ptr;
  88.     maybe       : BYTE;
  89.     stack_place : POINTER;
  90.  
  91.   BEGIN;
  92.  
  93.     {$IFDEF taskalbug}
  94.       WRITELN('Get task = ', stack_size);
  95.       DELAY(1000);
  96.     {$ENDIF}
  97.  
  98.     (*---------------------------------------------------------------------*)
  99.     (* Find an unused TCB                                                  *)
  100.     (*---------------------------------------------------------------------*)
  101.  
  102.     i           := 0;
  103.     this_one    := 0;
  104.     maybe_this  := 0;
  105.  
  106.     IF NOT system_startup THEN
  107.       WHILE (i < opt_block.max_task_no) AND (this_one = 0) DO
  108.         BEGIN;
  109.           INC(i);
  110.  
  111.           {$IFDEF taskalbug}
  112.             WITH task_array_ptr^[i] DO
  113.               WRITELN('Get task look -- ', element_tcb_ptr^.tcb_dead, ' / ',
  114.                                            element_stack_size);
  115.           {$ENDIF}
  116.  
  117.           WITH task_array_ptr^[i] DO
  118.             IF (element_tcb_ptr^.tcb_dead) THEN
  119.               BEGIN;
  120.  
  121.                 {$IFDEF taskalbug}
  122.                   WRITELN(' El = ', element_stack_size,
  123.                           ' SS = ', stack_size);
  124.                 {$ENDIF}
  125.  
  126.                 j := element_stack_size - INTEGER(stack_size);
  127.                 IF j = 0 THEN
  128.                   this_one := i;
  129.                 IF j > 0 THEN
  130.                   maybe_this := i;
  131.               END;
  132.  
  133.         END;
  134.  
  135.     IF this_one = 0 THEN
  136.       this_one := maybe_this;
  137.  
  138.     {$IFDEF taskalbug}
  139.       WRITELN('Get task found? -- ', this_one , ' / ', i);
  140.       DELAY(1000);
  141.     {$ENDIF}
  142.  
  143.     (*-----------------------------------------------------------------------*)
  144.     (* Use the one we found or build one if necessary                        *)
  145.     (*-----------------------------------------------------------------------*)
  146.  
  147.     IF this_one > 0 THEN
  148.       new_tcb := task_array_ptr^[this_one].element_tcb_ptr
  149.     ELSE
  150.       BEGIN;
  151.  
  152.         (*-------------------------------------------------------------------*)
  153.         (* Get the stack                                                     *)
  154.         (*-------------------------------------------------------------------*)
  155.  
  156.         IF MAXAVAIL >= stack_size THEN
  157.           BEGIN;
  158.             GETMEM(stack_place, stack_size);
  159.             FILLCHAR(stack_place^, stack_size, 0);
  160.           END
  161.         ELSE
  162.           BEGIN;
  163.             window_write_critical('', 'TK:: No room for stack');
  164.             task_create := NIL;
  165.             EXIT;
  166.           END;
  167.  
  168.         (*-------------------------------------------------------------------*)
  169.         (* Get the tcb                                                       *)
  170.         (*-------------------------------------------------------------------*)
  171.  
  172.         IF MAXAVAIL >= SIZEOF(tcb) THEN
  173.           NEW(new_tcb)
  174.         ELSE
  175.           BEGIN;
  176.             FREEMEM(stack_place, stack_size);
  177.             window_write_critical('', 'TK:: No room for tcb');
  178.             task_create := NIL;
  179.             EXIT;
  180.           END;
  181.  
  182.         (*-------------------------------------------------------------------*)
  183.         (* Add stack info to TCB                                             *)
  184.         (*-------------------------------------------------------------------*)
  185.  
  186.         new_tcb^.sseg_init := SEG(stack_place^);
  187.         new_tcb^.sseg_bot  := OFS(stack_place^);
  188.         new_tcb^.sptr_init := OFS(stack_place^) + stack_size - 16;
  189.         new_tcb^.sseg_size := stack_size;
  190.  
  191.         {$IFDEF stckdebug}
  192.           WRITELN('Get');
  193.           WITH new_tcb^ DO
  194.             BEGIN;
  195.               WRITELN('Stack -- ', pw2x(sseg_init, sptr_init));
  196.               WRITELN('Size = ', sseg_size);
  197.              END;
  198.         {$ENDIF}
  199.  
  200.       END;
  201.  
  202.     (*-----------------------------------------------------------------------*)
  203.     (* Add to the chain and count it!  It must be the next TCB in the chain  *)
  204.     (*-----------------------------------------------------------------------*)
  205.  
  206.     new_tcb^.next_tcb    := active_tcb^.next_tcb;
  207.     active_tcb^.next_tcb := new_tcb;
  208.  
  209.     INC(alive_tcb_count);
  210.  
  211.     status_window_change := TRUE;
  212.  
  213.     (*-----------------------------------------------------------------------*)
  214.     (* Initialize it                                                         *)
  215.     (*-----------------------------------------------------------------------*)
  216.  
  217.     tcb_init(new_tcb);
  218.  
  219.     (*-----------------------------------------------------------------------*)
  220.     (* Switch to new task                                                    *)
  221.     (*-----------------------------------------------------------------------*)
  222.  
  223.     task_start_place := ic;
  224.     task_start;
  225.  
  226.     task_create := new_tcb;
  227.  
  228.   END;
  229.  
  230. (*===========================================================================*)
  231. (* Destroy a task                                                            *)
  232. (*===========================================================================*)
  233.  
  234. PROCEDURE task_destroy(kill_tcb : tcb_ptr);
  235.  
  236.   VAR
  237.     b        : BOOLEAN;
  238.     work_tcb : tcb_ptr;
  239.  
  240.   BEGIN;
  241.  
  242.     (*-----------------------------------------------------------------------*)
  243.     (* Verify we are killing the right task                                  *)
  244.     (*-----------------------------------------------------------------------*)
  245.  
  246.      IF kill_tcb^.tcb_number <= overhead_tcb_count THEN
  247.        BEGIN;
  248.          WRITELN('Attempt to kill overhead task');
  249.          dump_all;
  250.          HALT;
  251.        END;
  252.  
  253.     (*-----------------------------------------------------------------------*)
  254.     (* Find this task's predecessor and drop killed TCB from chain           *)
  255.     (*-----------------------------------------------------------------------*)
  256.  
  257.     work_tcb := ring_tcb;
  258.  
  259.     b := FALSE;
  260.     REPEAT
  261.       b := work_tcb^.next_tcb = kill_tcb;
  262.       IF b THEN
  263.         work_tcb^.next_tcb  := kill_tcb^.next_tcb
  264.       ELSE
  265.         work_tcb := work_tcb^.next_tcb;
  266.     UNTIL b;
  267.  
  268.     (*-----------------------------------------------------------------------*)
  269.     (* Drop killed TCB                                                       *)
  270.     (*-----------------------------------------------------------------------*)
  271.  
  272.     DEC(alive_tcb_count);
  273.  
  274.     status_window_change := TRUE;
  275.  
  276.     (*-----------------------------------------------------------------------*)
  277.     (* Clean up                                                              *)
  278.     (*-----------------------------------------------------------------------*)
  279.  
  280.     tcb_drop(kill_tcb);
  281.  
  282.     (*-----------------------------------------------------------------------*)
  283.     (* If no stack to free, mark as dead and we are done                     *)
  284.     (*-----------------------------------------------------------------------*)
  285.  
  286.     IF kill_tcb^.sseg_size = 0 THEN
  287.       BEGIN;
  288.         kill_tcb^.tcb_dead := TRUE;
  289.         EXIT;
  290.       END;
  291.  
  292.     (*-----------------------------------------------------------------------*)
  293.     (* If not active then delete it                                          *)
  294.     (*-----------------------------------------------------------------------*)
  295.  
  296.     IF active_tcb <> kill_tcb THEN
  297.       task_free(kill_tcb);
  298.  
  299.   END;
  300.  
  301. (*===========================================================================*)
  302. (* Destroy the active task                                                   *)
  303. (*===========================================================================*)
  304.  
  305. PROCEDURE task_destroy_active;
  306.  
  307.   BEGIN;
  308.  
  309.     (*------------------------------------------------------------------------*)
  310.     (* Kill the active TCB                                                    *)
  311.     (*------------------------------------------------------------------------*)
  312.  
  313.     task_destroy(active_tcb);
  314.  
  315.     (*-----------------------------------------------------------------------*)
  316.     (* If we are now dead, then we are done.  TASK_SWITCH will never return  *)
  317.     (*-----------------------------------------------------------------------*)
  318.  
  319.     IF active_tcb^.tcb_dead THEN
  320.       task_switch;
  321.  
  322.     (*-----------------------------------------------------------------------*)
  323.     (* Next task is main                                                     *)
  324.     (*-----------------------------------------------------------------------*)
  325.  
  326.     main_switch := TRUE;
  327.  
  328.     (*-----------------------------------------------------------------------*)
  329.     (* Add to kill list                                                      *)
  330.     (*-----------------------------------------------------------------------*)
  331.  
  332.     active_tcb^.next_tcb := dead_tcb_list;
  333.     dead_tcb_list        := active_tcb;
  334.  
  335.     (*-----------------------------------------------------------------------*)
  336.     (* Switch away, never to return!                                         *)
  337.     (*-----------------------------------------------------------------------*)
  338.  
  339.     task_switch;
  340.  
  341.   END;
  342.  
  343. (*===========================================================================*)
  344. (* Initialize a TCB                                                          *)
  345. (*===========================================================================*)
  346.  
  347. PROCEDURE tcb_init(this_tcb : tcb_ptr);
  348.  
  349.   VAR
  350.     b         : BOOLEAN;
  351.     buff_size : WORD;
  352.     i         : BYTE;
  353.     look_tcb  : tcb_ptr;
  354.  
  355.   BEGIN;
  356.  
  357.     WITH this_tcb^ DO
  358.       BEGIN;
  359.  
  360.         (*-------------------------------------------------------------------*)
  361.         (* Clear tcb name                                                    *)
  362.         (*-------------------------------------------------------------------*)
  363.  
  364.         tcb_name := '';
  365.  
  366.         (*-------------------------------------------------------------------*)
  367.         (* Get a unique number                                               *)
  368.         (*-------------------------------------------------------------------*)
  369.  
  370.         IF sseg_size <> 0 THEN
  371.           BEGIN;
  372.             i := 2;
  373.             b := FALSE;
  374.  
  375.             REPEAT
  376.  
  377.               look_tcb := ring_tcb;
  378.               REPEAT
  379.                 look_tcb := look_tcb^.next_tcb;
  380.               UNTIL (look_tcb = ring_tcb) OR (look_tcb^.tcb_number = i);
  381.  
  382.               IF look_tcb^.tcb_number = i THEN
  383.                 INC(i)
  384.               ELSE
  385.                 b := TRUE;
  386.  
  387.             UNTIL b;
  388.  
  389.             tcb_number := i;
  390.           END;
  391.  
  392.         channel  := active_tcb^.channel;
  393.         tcb_port := active_port;
  394.  
  395.         buff_size := 651;
  396.         w_color   := default_data_color;
  397.  
  398.         IF active_port <> NIL THEN
  399.           WITH active_port^ DO
  400.             BEGIN;
  401.  
  402.               port_chan_s := port_char + byte_to_char[channel];
  403.  
  404.               CASE port_type OF
  405.                 port_g8bpq, port_aeapk232:
  406.                   ;
  407.                 port_bpqhost:
  408.                   buff_size := opt_block.bpq_buff;
  409.                 ELSE
  410.                   BEGIN;
  411.                     IF SIZEOF(host_to_tnc) > SIZEOF(tnc_to_host) THEN
  412.                        buff_size := SIZEOF(host_to_tnc)
  413.                     ELSE
  414.                        buff_size := SIZEOF(tnc_to_host);
  415.                   END;
  416.               END;
  417.  
  418.               w_color := port_color;
  419.             END;
  420.  
  421.         tcb_ovr_cnt := 0;
  422.  
  423.         GETMEM(tnc_htt, buff_size);
  424.  
  425.         tnc_tth    := @tnc_htt^;
  426.         tnc_b_size := buff_size;
  427.  
  428.         FILLCHAR(tnc_htt^, tnc_b_size, 0);
  429.  
  430.         FILLCHAR(tcb_transmit_idle,
  431.            SIZEOF(tcb_bid_level) + OFS(tcb_bid_level) - OFS(tcb_transmit_idle),
  432.            0);
  433.  
  434.         io_fe       := NIL;
  435.         path_fe     := NIL;
  436.  
  437.         FILLCHAR(uid_data, SIZEOF(uid_data), CHR(0));
  438.         uid_data.user_i_ptr := NIL;
  439.  
  440.         FILLCHAR(curr_msg, SIZEOF(curr_msg), CHR(0));
  441.  
  442.         curr_fwd.msg_p_i   := NIL;
  443.  
  444.         window             := 0;
  445.  
  446.         tnc_data           := active_tcb^.tnc_data;
  447.         tnc_in_chn         := NIL;
  448.  
  449.         i_data.long_length := 0;
  450.         i_data.str_data    := '';
  451.         o_data.long_length := 0;
  452.         o_data.str_data    := '';
  453.         stor_list          := NIL;
  454.  
  455.         c_input            := NIL;
  456.         conv_tcb           := NIL;
  457.  
  458.         stack_cnt          := 0;
  459.         stack_usage        := sptr_init;
  460.  
  461.         FILLCHAR(tcb_access_mode, SIZEOF(tcb_access_mode), CHR(0));
  462.  
  463.       END;
  464.  
  465.   END;
  466.  
  467. (*===========================================================================*)
  468. (* Free a process's resources                                                *)
  469. (*===========================================================================*)
  470.  
  471. PROCEDURE tcb_drop(this_tcb : tcb_ptr);
  472.   VAR
  473.     b            : BOOLEAN;
  474.     i            : INTEGER;
  475.     last_scb     : str_chain_ptr;
  476.     next_m_chain : str_m_chain;
  477.     next_mem     : mem_list_ptr;
  478.     port_test    : port_block_ptr;
  479.     size         : LONGINT;
  480.     this_mem     : mem_list_ptr;
  481.     work_scb     : str_chain_ptr;
  482.     work_m_chain : str_m_chain;
  483.     work_tcb     : tcb_ptr;
  484.  
  485.   BEGIN;
  486.  
  487.     (*-----------------------------------------------------------------------*)
  488.     (* Drop from connected list                                              *)
  489.     (*-----------------------------------------------------------------------*)
  490.  
  491.     port_test := this_tcb^.tcb_port;
  492.  
  493.     IF port_test <> NIL THEN
  494.       REPEAT
  495.  
  496.         FOR i := 0 TO port_test^.max_chan DO
  497.           IF port_test^.connected^[i] = this_tcb THEN
  498.             port_test^.connected^[i] := NIL;
  499.  
  500.         port_test := port_test^.next_port;
  501.  
  502.       UNTIL port_test = this_tcb^.tcb_port;
  503.  
  504.     (*-----------------------------------------------------------------------*)
  505.     (* Free the TNC buffer                                                   *)
  506.     (*-----------------------------------------------------------------------*)
  507.  
  508.     IF this_tcb^.tnc_htt <> NIL THEN
  509.       FREEMEM(this_tcb^.tnc_htt, this_tcb^.tnc_b_size);
  510.  
  511.     (*-----------------------------------------------------------------------*)
  512.     (* Free chained input buffers                                            *)
  513.     (*-----------------------------------------------------------------------*)
  514.  
  515.     next_m_chain := this_tcb^.tnc_in_chn;
  516.     WHILE next_m_chain <> NIL DO
  517.       BEGIN;
  518.         work_m_chain := next_m_chain;
  519.         next_m_chain := work_m_chain^.str_m_next;
  520.         FREEMEM(work_m_chain, 3 + 6 + work_m_chain^.str_m_data.long_length);
  521.       END;
  522.  
  523.     (*-----------------------------------------------------------------------*)
  524.     (* Free random storage                                                   *)
  525.     (*-----------------------------------------------------------------------*)
  526.  
  527.     IF this_tcb^.stor_list <> NIL THEN
  528.       BEGIN;
  529.  
  530.         this_mem := this_tcb^.stor_list;
  531.  
  532.         REPEAT
  533.  
  534.           next_mem := this_mem^.next_mem_list;
  535.           size := LONGINT(mem_overhead) + this_mem^.mem_size;
  536.  
  537.           FREEMEM(this_mem, size);
  538.  
  539.           this_mem := next_mem;
  540.  
  541.         UNTIL this_mem = NIL;
  542.  
  543.       END;
  544.  
  545.     (*-----------------------------------------------------------------------*)
  546.     (* Free conversational input chain                                       *)
  547.     (*-----------------------------------------------------------------------*)
  548.  
  549.     WHILE this_tcb^.c_input <> NIL DO
  550.       del_c_string(this_tcb);
  551.  
  552.     (*-----------------------------------------------------------------------*)
  553.     (* Remove this tcb from conversational chain                             *)
  554.     (*-----------------------------------------------------------------------*)
  555.  
  556.     drop_conv(this_tcb);
  557.  
  558.     (*-----------------------------------------------------------------------*)
  559.     (* Free file element                                                     *)
  560.     (*-----------------------------------------------------------------------*)
  561.  
  562.     IF this_tcb^.io_fe <> NIL THEN
  563.       WITH this_tcb^.io_fe^ DO
  564.         BEGIN;
  565.  
  566.           IF NOT fe_type THEN
  567.             BEGIN;
  568.               {$I-}
  569.               CLOSE(fe_text);
  570.               i := IORESULT;
  571.               {$I+}
  572.             END
  573.           ELSE
  574.             BEGIN;
  575.               {$I-}
  576.               CLOSE(fe_text);
  577.               i := IORESULT;
  578.               {$I+}
  579.             END;
  580.  
  581.           DISPOSE(this_tcb^.io_fe);
  582.           this_tcb^.io_fe := NIL;
  583.  
  584.         END;
  585.  
  586.     (*-----------------------------------------------------------------------*)
  587.     (* Free path file element                                                *)
  588.     (*-----------------------------------------------------------------------*)
  589.  
  590.     IF this_tcb^.path_fe <> NIL THEN
  591.       BEGIN;
  592.         WITH this_tcb^.path_fe^ DO
  593.           BEGIN;
  594.  
  595.             IF NOT fe_type THEN
  596.               BEGIN;
  597.                 {$I-}
  598.                 CLOSE(fe_text);
  599.                 i := IORESULT;
  600.                 {$I+}
  601.               END
  602.             ELSE
  603.               BEGIN;
  604.                 {$I-}
  605.                 CLOSE(fe_text);
  606.                 i := IORESULT;
  607.                 {$I+}
  608.               END;
  609.  
  610.           END;
  611.  
  612.         DISPOSE(this_tcb^.path_fe);
  613.         this_tcb^.path_fe := NIL;
  614.  
  615.       END;
  616.  
  617.     (*-----------------------------------------------------------------------*)
  618.     (* Mark message as not forward in progress                               *)
  619.     (*-----------------------------------------------------------------------*)
  620.  
  621.     IF this_tcb^.curr_fwd.msg_p_i <> NIL THEN
  622.       WITH this_tcb^.curr_fwd, this_tcb^.curr_fwd.msg_p_i^ DO
  623.         BEGIN;
  624.           {$IFDEF fwdkdebug}
  625.           WRITELN('task unselect msg -- ', msg_i_mb^.msg_number);
  626.           {$ENDIF}
  627.           b := FALSE;
  628.           IF msg_p_item <> 0 THEN
  629.             WITH msg_i_dr^.msg_dr_dblk^ DO
  630.               BEGIN;
  631.                 WITH msg_d_array[msg_p_item] DO
  632.                   msg_d_flag := msg_d_flag AND (NOT df_fwd_process);
  633.                 FOR i := 1 TO msg_d_no DO
  634.                   b := b
  635.                       OR ((msg_d_array[i].msg_d_flag AND df_fwd_process) <> 0);
  636.               END;
  637.           IF NOT b THEN
  638.             msg_i_mb.msg_flag := msg_i_mb.msg_flag AND (NOT mf_fwd_process);
  639.         END;
  640.  
  641.     (*-----------------------------------------------------------------------*)
  642.     (* Stack display                                                         *)
  643.     (*-----------------------------------------------------------------------*)
  644.  
  645.     stack_record(this_tcb);
  646.  
  647.     (*-----------------------------------------------------------------------*)
  648.     (* Free all semaphores                                                   *)
  649.     (*-----------------------------------------------------------------------*)
  650.  
  651.     process_free_semaphore(this_tcb);
  652.  
  653.   END;
  654.  
  655. (*===========================================================================*)
  656. (* Free the last of a task's memory                                          *)
  657. (*===========================================================================*)
  658.  
  659. PROCEDURE task_free(this_tcb : tcb_ptr);
  660.  
  661.   VAR
  662.     p : POINTER;
  663.  
  664.   BEGIN;
  665.  
  666.     {$IFDEF stckdebug}
  667.       WRITELN('Free');
  668.       WITH this_tcb^ DO
  669.         BEGIN;
  670.         WRITELN('Stack -- ', pw2x(this_tcb^.sseg_init, this_tcb^.sptr_init));
  671.         WRITELN('Size = ', sseg_size);
  672.         END;
  673.     {$ENDIF}
  674.  
  675.     (*-----------------------------------------------------------------------*)
  676.     (* Free stack                                                            *)
  677.     (*-----------------------------------------------------------------------*)
  678.  
  679.     p := PTR(this_tcb^.sseg_init, this_tcb^.sseg_bot);
  680.     FREEMEM(p, this_tcb^.sseg_size);
  681.  
  682.     (*-----------------------------------------------------------------------*)
  683.     (* Drop TCB                                                              *)
  684.     (*-----------------------------------------------------------------------*)
  685.  
  686.     DISPOSE(this_tcb);
  687.  
  688.   END;
  689.  
  690. (*===========================================================================*)
  691. (* See if a task is dead                                                     *)
  692. (*===========================================================================*)
  693.  
  694. FUNCTION  task_is_dead(this_tcb : tcb_ptr) : BOOLEAN;
  695.  
  696.   VAR
  697.     work_tcb : tcb_ptr;
  698.  
  699.   BEGIN;
  700.  
  701.     (*------------------------------------------------------------------------*)
  702.     (* See if the task is in the chain                                        *)
  703.     (*------------------------------------------------------------------------*)
  704.  
  705.     work_tcb := ring_tcb;
  706.  
  707.     WHILE (work_tcb <> this_tcb) AND (work_tcb^.next_tcb <> ring_tcb) DO
  708.       work_tcb := work_tcb^.next_tcb;
  709.  
  710.     task_is_dead := work_tcb <> this_tcb;
  711.  
  712.   END;
  713.  
  714. (*===========================================================================*)
  715. (* Turn off the checks                                                       *)
  716. (*===========================================================================*)
  717.  
  718. {$R-}    {Range check off}
  719. {$S-}    {Stack checking off}
  720. {$I-}    {I/O checking off}
  721. {$V-}    {String var checks off}
  722.  
  723. (*===========================================================================*)
  724. (* This subroutine starts a task that we just created                        *)
  725. (*===========================================================================*)
  726.  
  727. PROCEDURE task_start;
  728.  
  729.   PROCEDURE now_call_it;
  730.  
  731.     BEGIN;
  732.  
  733.       (*-----------------------------------------------------------------------*)
  734.       (* Call the guy.....                                                     *)
  735.       (*-----------------------------------------------------------------------*)
  736.  
  737.       ASM;
  738.         CALL task_start_place
  739.       END;
  740.  
  741.     END;
  742.  
  743.   PROCEDURE stack_setup;
  744.     VAR
  745.       w : ^WORD;
  746.  
  747.     BEGIN;
  748.  
  749.       w := PTR(set_ss, set_bp-8);
  750.       FILLCHAR(w^, 16, #0);
  751.  
  752.     END;
  753.  
  754.   BEGIN;
  755.  
  756.     {$IFDEF taskdebug}
  757.       WRITELN;
  758.       WRITELN('From');
  759.       WRITELN('STACK   = ',pw2x(SSEG, SPTR));
  760.       WRITELN('DSEG    = ',w2x(DSEG));
  761.       WRITELN('PREFIX  = ',w2x(PREFIXSEG));
  762.       WRITELN('BPTR    = ',a2x(set_bp));
  763.     {$ENDIF}
  764.  
  765.     (*-----------------------------------------------------------------------*)
  766.     (* Save the old task's overlay stuff.                                    *)
  767.     (*-----------------------------------------------------------------------*)
  768.  
  769.     IF NOT active_tcb^.tcb_no_overlay THEN
  770.       overlay_save;
  771.  
  772.     (*-----------------------------------------------------------------------*)
  773.     (* Save current SS:SP and BP                                             *)
  774.     (*-----------------------------------------------------------------------*)
  775.  
  776.     ASM;
  777.       MOV set_bp,BP
  778.     END;
  779.  
  780.     WITH active_tcb^ DO
  781.       BEGIN;
  782.         sseg_value := SSEG;
  783.         sptr_value := SPTR;
  784.         bptr_value := set_bp;
  785.       END;
  786.  
  787.     (*-----------------------------------------------------------------------*)
  788.     (* Switch tasks                                                          *)
  789.     (*-----------------------------------------------------------------------*)
  790.  
  791.     active_tcb  := active_tcb^.next_tcb;
  792.     active_port := active_tcb^.tcb_port;
  793.  
  794.     (*-----------------------------------------------------------------------*)
  795.     (* Restore SS:SP, BP and ready stack                                     *)
  796.     (*-----------------------------------------------------------------------*)
  797.  
  798.     set_ss := active_tcb^.sseg_init;
  799.     set_sp := active_tcb^.sptr_init;
  800.     set_bp := active_tcb^.sptr_init;
  801.  
  802.     stack_setup;
  803.  
  804.     ASM;
  805.       CLI
  806.       MOV SS,set_ss
  807.       MOV SP,set_sp
  808.       MOV BP,set_bp
  809.       STI
  810.     END;
  811.  
  812.     (*-----------------------------------------------------------------------*)
  813.     (* Show switch to                                                        *)
  814.     (*-----------------------------------------------------------------------*)
  815.  
  816.     {$IFDEF taskdebug}
  817.       WRITELN;
  818.       WRITELN('To');
  819.       WRITELN('STACK   = ',pw2x(SSEG, SPTR));
  820.       WRITELN('DSEG    = ',w2x(DSEG));
  821.       WRITELN('PREFIX  = ',w2x(PREFIXSEG));
  822.       WRITELN('BPTR    = ',a2x(set_bp));
  823.     {$ENDIF}
  824.  
  825.     (*-----------------------------------------------------------------------*)
  826.     (* Call the guy.....                                                     *)
  827.     (*-----------------------------------------------------------------------*)
  828.  
  829.     now_call_it;
  830.  
  831.     WRITELN('Impossible return!!!! -- help !!!!');
  832.  
  833.     HALT;
  834.  
  835.   END;
  836.  
  837. (*===========================================================================*)
  838. (* Switch to next task                                                       *)
  839. (*===========================================================================*)
  840.  
  841. PROCEDURE task_switch;
  842.   BEGIN;
  843.  
  844.     (*-----------------------------------------------------------------------*)
  845.     (* Reset window to a known place.  This simulates a SELECT               *)
  846.     (*-----------------------------------------------------------------------*)
  847.  
  848.     IF current_window <> window_reset THEN
  849.       BEGIN;
  850.         current_window := window_reset;
  851.         WINDOW( 1, window_location[window_full_screen].window_u_y,
  852.                80, window_location[window_full_screen].window_l_y);
  853.  
  854.         GOTOXY(window_array[window_reset].window_cursor, reset_window_y);
  855.       END;
  856.  
  857.     (*-----------------------------------------------------------------------*)
  858.     (* Save the old task's overlay stuff.                                    *)
  859.     (*-----------------------------------------------------------------------*)
  860.  
  861.     IF NOT active_tcb^.tcb_no_overlay THEN
  862.       overlay_save;
  863.  
  864.     (*-----------------------------------------------------------------------*)
  865.     (* Show switch from                                                      *)
  866.     (*-----------------------------------------------------------------------*)
  867.  
  868.     {$IFDEF taskdebug}
  869.       WRITELN;
  870.       WRITELN('From');
  871.       WRITELN('STACK   = ',pw2x(SSEG, SPTR));
  872.       WRITELN('DSEG    = ',w2x(DSEG));
  873.       WRITELN('PREFIX  = ',w2x(PREFIXSEG));
  874.       WRITELN('BPTR    = ',a2x(set_bp));
  875.     {$ENDIF}
  876.  
  877.     (*-----------------------------------------------------------------------*)
  878.     (* Save current SS:SP and BP                                             *)
  879.     (*-----------------------------------------------------------------------*)
  880.  
  881.     ASM;
  882.       MOV set_bp,BP
  883.     END;
  884.  
  885.     WITH active_tcb^ DO
  886.       BEGIN;
  887.         sseg_value := SSEG;
  888.         sptr_value := SPTR;
  889.         bptr_value := set_bp;
  890.       END;
  891.  
  892.     (*-----------------------------------------------------------------------*)
  893.     (* Switch tasks                                                          *)
  894.     (*-----------------------------------------------------------------------*)
  895.  
  896.     IF shutdown_switch OR main_switch THEN
  897.       BEGIN;
  898.         active_tcb  := main_tcb;
  899.         main_switch := FALSE;
  900.       END
  901.     ELSE
  902.       active_tcb := active_tcb^.next_tcb;
  903.  
  904.     active_port := active_tcb^.tcb_port;
  905.  
  906.     (*-----------------------------------------------------------------------*)
  907.     (* Restore SS:SP and BP                                                  *)
  908.     (*-----------------------------------------------------------------------*)
  909.  
  910.     WITH active_tcb^ DO
  911.       BEGIN;
  912.         set_ss := sseg_value;
  913.         set_sp := sptr_value;
  914.         set_bp := bptr_value;
  915.         ASM;
  916.           CLI
  917.           MOV SS,set_ss
  918.           MOV SP,set_sp
  919.           MOV BP,set_bp
  920.           STI
  921.         END;
  922.       END;
  923.  
  924.     (*-----------------------------------------------------------------------*)
  925.     (* Show switch to                                                        *)
  926.     (*-----------------------------------------------------------------------*)
  927.  
  928.     {$IFDEF taskdebug}
  929.       WRITELN;
  930.       WRITELN('To');
  931.       WRITELN('STACK   = ',pw2x(SSEG, SPTR));
  932.       WRITELN('DSEG    = ',w2x(DSEG));
  933.       WRITELN('PREFIX  = ',w2x(PREFIXSEG));
  934.       WRITELN('BPTR    = ',a2x(set_bp));
  935.     {$ENDIF}
  936.  
  937.     IF LO(signal_place^) < ORD('a') THEN
  938.       signal_place^ := active_tcb^.tcb_number + ORD('a') - 1 + $7800
  939.     ELSE
  940.       signal_place^ := active_tcb^.tcb_number + ORD('A') - 1 + $7800;
  941.  
  942.     (*-----------------------------------------------------------------------*)
  943.     (* Restore the new task's overlay stuff.                                 *)
  944.     (*-----------------------------------------------------------------------*)
  945.  
  946.     IF NOT active_tcb^.tcb_no_overlay THEN
  947.       overlay_restore;
  948.  
  949.     (*-----------------------------------------------------------------------*)
  950.     (* We now exit using the new task's stack                                *)
  951.     (*-----------------------------------------------------------------------*)
  952.  
  953.   END;
  954.  
  955. END.
  956.